unit Debugger;

interface

procedure BeginHeapInspect;
procedure EndHeapInspect;

implementation

uses
  SysUtils, Windows, Dialogs;

const
  MaxHeapInfoListSize = 20;
type
  THeapInfo = record
    GetMemCount     : integer;
    FreeMemCount    : integer;
    ReallocMemCount : integer;
  end;

var
  OldMemMgr         : TMemoryManager;
  HeapInfoList      : array [1..MaxHeapInfoListSize] of THeapInfo;
  HeapInfoListSize  : integer = 0;

function NewGetMem(Size: Integer): Pointer;
begin
  with HeapInfoList[HeapInfoListSize] do
    Inc(GetMemCount);
  Result := OldMemMgr.GetMem(Size);
end;

function NewFreeMem(P: Pointer): Integer;
begin
  with HeapInfoList[HeapInfoListSize] do
    Inc(FreeMemCount);
  Result := OldMemMgr.FreeMem(P);
end;

function NewReallocMem(P: Pointer; Size: Integer): Pointer;
begin
  with HeapInfoList[HeapInfoListSize] do
    Inc(ReallocMemCount);
  Result := OldMemMgr.ReallocMem(P, Size);
end;

const
  NewMemMgr: TMemoryManager = (
  GetMem: NewGetMem;
  FreeMem: NewFreeMem;
  ReallocMem: NewReallocMem);

procedure BeginHeapInspect;
begin
  if HeapInfoListSize=MaxHeapInfoListSize then
    raise Exception.Create('Demasiados HeapInspect anidados ('+IntToStr(MaxHeapInfoListSize)+')');
  inc(HeapInfoListSize);
  fillchar(HeapInfoList[HeapInfoListSize],SizeOf(THeapInfo),0);
  if HeapInfoListSize=1 then
  begin
    GetMemoryManager(OldMemMgr);
    SetMemoryManager(NewMemMgr);
  end;
end;

procedure EndHeapInspect;
var
  i : THeapInfo;
begin
  if HeapInfoListSize=0 then
    raise Exception.Create('EndHeapInspect sin su correspondiente BeginHeapInspect');
  i := HeapInfoList[HeapInfoListSize];
  if HeapInfoListSize=1 then
    SetMemoryManager(OldMemMgr);
  dec(HeapInfoListSize);
  if i.GetMemCount<>i.FreeMemCount then
  begin
    OutputDebugString(PChar('La cantidad de GetMems no es igual a la de FreeMems'));
    OutputDebugString(PChar('GetMems='+IntToStr(i.GetMemCount)));
    OutputDebugString(PChar('FreeMems='+IntToStr(i.FreeMemCount)));
    OutputDebugString(PChar('ReallocMems='+IntToStr(i.ReallocMemCount)));
  end;
    {MessageDlg('La cantidad de GetMems no es igual a la de FreeMems'#13+
               'GetMems='+IntToStr(i.GetMemCount)+#13+
               'FreeMems='+IntToStr(i.FreeMemCount)+#13+
               'ReallocMems='+IntToStr(i.ReallocMemCount),mtError,[mbOk],0);}
    {MessageBox(0,PChar('La cantidad de GetMems no es igual a la de FreeMems'#13+
                       'GetMems='+IntToStr(i.GetMemCount)+#13+
                       'FreeMems='+IntToStr(i.FreeMemCount)+#13+
                       'ReallocMems='+IntToStr(i.ReallocMemCount)),'Error',MB_TASKMODAL+MB_ICONERROR+MB_OK);}
    {raise Exception.Create('La cantidad de GetMems no es igual a la de FreeMems'#13+
                           'GetMems='+IntToStr(i.GetMemCount)+#13+
                           'FreeMems='+IntToStr(i.FreeMemCount)+#13+
                           'ReallocMems='+IntToStr(i.ReallocMemCount));}
end;

end.
